home *** CD-ROM | disk | FTP | other *** search
- /* errchk.f -- translated by f2c (version of 3 February 1990 3:36:42).
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
- */
-
- #include "f2c.h"
-
- /* Common Block Declarations */
-
- struct {
- integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens,
- nsens, ifour, nfour, ifield, icode, idelim, icolum, insize,
- junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr,
- numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap,
- iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3,
- lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod,
- nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf,
- irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar,
- lvntmp;
- } tabinf_;
-
- #define tabinf_1 tabinf_
-
- struct {
- doublereal atime, aprog[3], adate, atitle[10], defl, defw, defad, defas,
- rstats[50];
- integer iwidth, lwidth, nopage;
- } miscel_;
-
- #define miscel_1 miscel_
-
- struct {
- integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt,
- nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
- } cirdat_;
-
- #define cirdat_1 cirdat_
-
- struct {
- integer maxtim, itime, icost;
- } cje_;
-
- #define cje_1 cje_
-
- struct {
- doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu,
- sfactr;
- integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno,
- itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
- } status_;
-
- #define status_1 status_
-
- struct {
- integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod,
- lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
- } flags_;
-
- #define flags_1 flags_
-
- struct {
- doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin,
- reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
- pivrel;
- } knstnt_;
-
- #define knstnt_1 knstnt_
-
- struct {
- doublereal tcstar[2], tcstop[2], tcincr[2];
- integer icvflg, itcelm[2], kssop, kinel, kidin, kovar, kidout;
- } dc_;
-
- #define dc_1 dc_
-
- struct {
- doublereal fstart, fstop, fincr, skw2, refprl, spw2;
- integer jacflg, idfreq, inoise, nosprt, nosout, nosin, idist, idprt;
- } ac_;
-
- #define ac_1 ac_
-
- struct {
- doublereal tstep, tstop, tstart, delmax, tdmax, forfre;
- integer jtrflg;
- } tran_;
-
- #define tran_1 tran_
-
- struct {
- doublereal xincr, string[15], xstart, yvar[8];
- integer itab[8], itype[8], ilogy[8], npoint, numout, kntr, numdgt;
- } outinf_;
-
- #define outinf_1 outinf_
-
- struct {
- doublereal value[200000];
- } blank_;
-
- #define blank_1 blank_
-
- /* Table of constant values */
-
- static integer c__1 = 1;
- static integer c__4 = 4;
- static integer c__2 = 2;
- static integer c__0 = 0;
-
- /* spice version 2g.6 sccsid=errchk.ma 3/15/83 */
- /*< subroutine errchk >*/
- /* Subroutine */ int errchk_()
- {
- /* Initialized data */
-
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_62 = { {'d', 'c', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
-
- #define alsdc (*(doublereal *)&equiv_62)
-
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_63 = { {'t', 'r', 'a', 'n', ' ', ' ', ' ', ' '}, 0. };
-
- #define alstr (*(doublereal *)&equiv_63)
-
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_64 = { {'a', 'c', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
-
- #define alsac (*(doublereal *)&equiv_64)
-
- static struct {
- char e_1[16];
- doublereal e_2;
- } equiv_65 = { {'t', 'r', 'a', 'p', ' ', ' ', ' ', ' ', 'g', 'e', 'a',
- 'r', ' ', ' ', ' ', ' '}, 0. };
-
- #define aname ((doublereal *)&equiv_65)
-
- static struct {
- char e_1[32];
- doublereal e_2;
- } equiv_66 = { {'o', 'p', 't', 'i', 'o', 'n', ' ', 's', 'u', 'm', 'm',
- 'a', 'r', 'y', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ',
- ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' ', ' '}, 0. };
-
- #define titlop ((doublereal *)&equiv_66)
-
- static struct {
- char e_1[4];
- integer e_2;
- } equiv_67 = { {'.', 'u', ' ', ' '}, 0 };
-
- #define ndefin (*(integer *)&equiv_67)
-
- static integer nnods[50] = { 2,2,2,0,2,2,2,2,2,2,2,4,3,4,0,0,4,0,1,0,0,0,
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2,2,0,0,0,0,0,0,0 };
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_68 = { {'e', 'l', 'e', 'm', 'e', 'n', 't', ' '}, 0. };
-
- #define aelmt (*(doublereal *)&equiv_68)
-
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_69 = { {'m', 'o', 'd', 'e', 'l', ' ', ' ', ' '}, 0. };
-
- #define amodel (*(doublereal *)&equiv_69)
-
- static struct {
- char e_1[8];
- doublereal e_2;
- } equiv_70 = { {'o', 'u', 't', 'p', 'u', 't', ' ', ' '}, 0. };
-
- #define aoutpt (*(doublereal *)&equiv_70)
-
-
- /* Format strings */
- static char fmt_41[] = "(\0020*error*: \002,2a8,\002 has been reference\
- d but not defined\002/)";
- static char fmt_321[] = "(\0020*error*: circuit has no nodes\002/)";
- static char fmt_661[] = "(\0020*error*: element \002,a8,\002 piecewise \
- linear source table not increasing in time\002)";
- static char fmt_1601[] = "(\0020dc analysis -\002,/,\0020 gmin =\
- \002,1pd10.3,/,\002 reltol = \002,d10.3,/,\002 abstol = \002,d10.3,\
- /,\002 vntol = \002,d10.3,/,\002 lvlcod = \002,i6,/,\002 itl1 \
- = \002,i6,/,\002 itl2 = \002,i6,/)";
- static char fmt_1605[] = "(\002 pivtol = \002,1pd10.3,/,\002 piv\
- rel = \002,d10.3)";
- static char fmt_1611[] = "(\0020transient analysis -\002,/,\0020 meth\
- od = \002,a8,/,\002 maxord = \002,i6,/,\002 chgtol = \002,1pd10.3,/\
- ,\002 trtol = \002,d10.3,/,\002 lvltim = \002,i6,/,\002 mu \
- = \002,0pf10.3,/,\002 itl3 = \002,i6,/,\002 itl4 = \002,i6,/,\
- \002 itl5 = \002,i6,/)";
- static char fmt_1621[] = "(\0020miscellaneous -\002,/,\0020 limpts =\
- \002,i6,/,\002 limtim = \002,i6,/,\002 cptime = \002,i9,/,\002 \
- numdgt = \002,i6,/,\002 tnom = \002,0pf10.3,/,\002 defl = \002,1\
- pd10.3,/,\002 defw = \002,d10.3,/,\002 defad = \002,d10.3,/,\002 \
- defas = \002,d10.3)";
- static char fmt_1701[] = "(\0020warning: more than \002,i5,\002 points \
- for \002,a4,\002 analysis,\002,/1x,\002analysis omitted. this limit may be \
- overridden using the \002,/1x,\002limpts parameter on the .option card\002/)";
-
- static char fmt_1711[] = "(\0020warning: no \002,a4,\002 outputs specif\
- ied .\002,\002.. analysis omitted\002/)";
- static char fmt_1736[] = "(\0020warning: fourier analysis fundamental f\
- requency is incompatible with\002/11x,\002transient analysis print interval \
- ... fourier analysis omitted\002/)";
-
- /* System generated locals */
- integer i_1, i_2;
- doublereal d_1, d_2;
-
- /* Builtin functions */
- integer s_wsfe(), do_fio(), e_wsfe();
- double sqrt(), sin(), cos();
-
- /* Local variables */
- static doublereal anam;
- extern /* Subroutine */ int find_();
- static integer node, ibkp, locp, locv;
- static doublereal temp;
- static integer iknt, nump, node1, node2, node3, node4;
- extern /* Subroutine */ int getm4_(), getm8_(), copy4_();
- static integer lptr1, lptr2;
- extern /* Subroutine */ int zero8_();
- static integer i, j, nbkpt;
- static doublereal t1;
- static integer jstop, jtype, ntemp;
- extern /* Subroutine */ int title_();
- static doublereal t2;
- static integer id;
- static doublereal td;
- extern /* Subroutine */ int modchk_();
- #define nodplc ((integer *)&blank_1)
- #define cvalue ((complex *)&blank_1)
- extern /* Subroutine */ int second_();
- static integer loc;
- extern /* Subroutine */ int putnod_();
- static integer nssnod;
- extern /* Subroutine */ int sizmem_(), getnod_();
- static integer nic;
- extern /* Subroutine */ int subckt_(), lnkref_(), subnam_(), clrmem_(),
- relmem_(), elprnt_(), topchk_();
- static integer nl1, nl2;
- static doublereal tol;
- extern /* Subroutine */ int extmem_(), shlsrt_();
- static doublereal forprd;
- static integer ifwdth, noprln, noprex, locnew;
-
- /* Fortran I/O blocks */
- static cilist io__18 = { 0, 0, 0, fmt_41, 0 };
- static cilist io__25 = { 0, 0, 0, fmt_321, 0 };
- static cilist io__35 = { 0, 0, 0, fmt_661, 0 };
- static cilist io__45 = { 0, 0, 0, fmt_1601, 0 };
- static cilist io__46 = { 0, 0, 0, fmt_1605, 0 };
- static cilist io__47 = { 0, 0, 0, fmt_1611, 0 };
- static cilist io__48 = { 0, 0, 0, fmt_1621, 0 };
- static cilist io__49 = { 0, 0, 0, fmt_1701, 0 };
- static cilist io__50 = { 0, 0, 0, fmt_1711, 0 };
- static cilist io__51 = { 0, 0, 0, fmt_1701, 0 };
- static cilist io__52 = { 0, 0, 0, fmt_1711, 0 };
- static cilist io__54 = { 0, 0, 0, fmt_1736, 0 };
- static cilist io__55 = { 0, 0, 0, fmt_1701, 0 };
- static cilist io__56 = { 0, 0, 0, fmt_1711, 0 };
-
-
- /*< implicit double precision (a-h,o-z) >*/
-
-
- /* this routine drives the pre-processing and general error-checking
- */
- /* of input performed by spice. */
-
- /* spice version 2g.6 sccsid=tabinf 3/15/83 */
- /*< common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
- /*< 1 isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
- /*< 2 junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
- /*< 3 nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
- /*< 4 lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
- /*< 5 imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
- /*< 6 loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
- /*< 7 irowno,jcolno,nttbr,nttar,lvntmp >*/
- /* spice version 2g.6 sccsid=miscel 3/15/83 */
- /*< common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad, >*/
- /*< 1 defas,rstats(50),iwidth,lwidth,nopage >*/
- /* spice version 2g.6 sccsid=cirdat 3/15/83 */
- /*< common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
- /*< 1 nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
- /* spice version 2g.6 sccsid=cje 3/15/83 */
- /*< common /cje/ maxtim,itime,icost >*/
- /* spice version 2g.6 sccsid=status 3/15/83 */
- /*< common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
- /*< 1 xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
- /*< 2 iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
- /* spice version 2g.6 sccsid=flags 3/15/83 */
- /*< common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
- /*< 1 lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
- /* spice version 2g.6 sccsid=knstnt 3/15/83 */
- /*< common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
- /*< 1 gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
- /*< 2 pivtol,pivrel >*/
- /* spice version 2g.6 sccsid=dc 3/15/83 */
- /*< common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop, >*/
- /*< 1 kinel,kidin,kovar,kidout >*/
- /* spice version 2g.6 sccsid=ac 3/15/83 */
- /*< common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq, >*/
- /*< 1 inoise,nosprt,nosout,nosin,idist,idprt >*/
- /* spice version 2g.6 sccsid=tran 3/15/83 */
- /*< common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg >*/
- /* spice version 2g.6 sccsid=outinf 3/15/83 */
- /*< common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8), >*/
- /*< 1 ilogy(8),npoint,numout,kntr,numdgt >*/
- /* spice version 2g.6 sccsid=blank 3/15/83 */
- /*< common /blank/ value(200000) >*/
- /*< integer nodplc(64) >*/
- /*< complex cvalue(32) >*/
- /*< equivalence (value(1),nodplc(1),cvalue(1)) >*/
-
-
- /*< dimension titlop(4) >*/
- /*< dimension nnods(50),aname(2) >*/
- /*< data aname / 4htrap, 4hgear / >*/
- /*< data titlop / 8hoption s, 8hummary , 8h , 8h / >*/
- /*< data ndefin / 2h.u / >*/
- /*< data nnods / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2, >*/
- /*< 1 2, 4, 3, 4, 0, 0, 4, 0, 1, 0, >*/
- /*< 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, >*/
- /*< 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, >*/
- /*< 4 2, 2, 2, 0, 0, 0, 0, 0, 0, 0 / >*/
- /*< data aelmt,amodel,aoutpt /7helement,5hmodel,6houtput/ >*/
- /*< data alsdc,alstr,alsac / 2hdc, 4htran, 2hac / >*/
-
-
- /*< call second(t1) >*/
- second_(&t1);
- /*< do 60 id=1,50 >*/
- for (id = 1; id <= 50; ++id) {
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 10 if (loc.eq.0) go to 60 >*/
- L10:
- if (loc == 0) {
- goto L60;
- }
- /*< if (nodplc(loc+2).ne.ndefin) go to 50 >*/
- if (nodplc[loc + 1] != ndefin) {
- goto L50;
- }
- /*< nogo=1 >*/
- flags_1.nogo = 1;
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< if (id.ge.21) go to 20 >*/
- if (id >= 21) {
- goto L20;
- }
- /*< anam=aelmt >*/
- anam = aelmt;
- /*< go to 40 >*/
- goto L40;
- /*< 20 if (id.ge.31) go to 30 >*/
- L20:
- if (id >= 31) {
- goto L30;
- }
- /*< anam=amodel >*/
- anam = amodel;
- /*< go to 40 >*/
- goto L40;
- /*< 30 anam=aoutpt >*/
- L30:
- anam = aoutpt;
- /*< 40 write (iofile,41) anam,value(locv) >*/
- L40:
- io__18.ciunit = status_1.iofile;
- s_wsfe(&io__18);
- do_fio(&c__1, (char *)&anam, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
- doublereal));
- e_wsfe();
- /*< 41 format('0*error*: ',2a8,' has been referenced but not defined'/) >*/
- /*< 50 loc=nodplc(loc) >*/
- L50:
- loc = nodplc[loc - 1];
- /*< go to 10 >*/
- goto L10;
- /*< 60 continue >*/
- L60:
- ;}
- /*< if (nogo.ne.0) go to 2000 >*/
- if (flags_1.nogo != 0) {
- goto L2000;
- }
-
- /* construct ordered list of user specified nodes */
-
- /*< call getm4(junode,1) >*/
- getm4_(&tabinf_1.junode, &c__1);
- /*< nodplc(junode+1)=0 >*/
- nodplc[tabinf_1.junode] = 0;
- /*< nunods=1 >*/
- cirdat_1.nunods = 1;
- /*< do 180 id=1,50 >*/
- for (id = 1; id <= 50; ++id) {
- /*< if (nnods(id).eq.0) go to 180 >*/
- if (nnods[id - 1] == 0) {
- goto L180;
- }
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 110 if (loc.eq.0) go to 180 >*/
- L110:
- if (loc == 0) {
- goto L180;
- }
- /*< if (id.le.4) go to 120 >*/
- if (id <= 4) {
- goto L120;
- }
- /*< if (id.le.8) go to 150 >*/
- if (id <= 8) {
- goto L150;
- }
- /*< if (id.eq.19) go to 165 >*/
- if (id == 19) {
- goto L165;
- }
- /*< if (id.le.40) go to 120 >*/
- if (id <= 40) {
- goto L120;
- }
- /*< if (id.le.43) go to 170 >*/
- if (id <= 43) {
- goto L170;
- }
- /*< 120 jstop=loc+nnods(id)-1 >*/
- L120:
- jstop = loc + nnods[id - 1] - 1;
- /*< do 130 j=loc,jstop >*/
- i_1 = jstop;
- for (j = loc; j <= i_1; ++j) {
- /*< call putnod(nodplc(j+2)) >*/
- putnod_(&nodplc[j + 1]);
- /*< 130 continue >*/
- /* L130: */
- }
- /*< go to 170 >*/
- goto L170;
- /*< 150 call putnod(nodplc(loc+2)) >*/
- L150:
- putnod_(&nodplc[loc + 1]);
- /*< call putnod(nodplc(loc+3)) >*/
- putnod_(&nodplc[loc + 2]);
- /*< if (id.ge.7) go to 170 >*/
- if (id >= 7) {
- goto L170;
- }
- /*< locp=nodplc(loc+id+1) >*/
- locp = nodplc[loc + id];
- /*< nssnod=2*nodplc(loc+4) >*/
- nssnod = nodplc[loc + 3] << 1;
- /*< 155 do 160 j=1,nssnod >*/
- L155:
- i_1 = nssnod;
- for (j = 1; j <= i_1; ++j) {
- /*< call putnod(nodplc(locp+j)) >*/
- putnod_(&nodplc[locp + j - 1]);
- /*< 160 continue >*/
- /* L160: */
- }
- /*< go to 170 >*/
- goto L170;
- /*< 165 locp=nodplc(loc+2) >*/
- L165:
- locp = nodplc[loc + 1];
- /*< call sizmem(nodplc(loc+2),nssnod) >*/
- sizmem_(&nodplc[loc + 1], &nssnod);
- /*< go to 155 >*/
- goto L155;
- /*< 170 loc=nodplc(loc) >*/
- L170:
- loc = nodplc[loc - 1];
- /*< go to 110 >*/
- goto L110;
- /*< 180 continue >*/
- L180:
- ;}
- /*< if (nogo.ne.0) go to 2000 >*/
- if (flags_1.nogo != 0) {
- goto L2000;
- }
- /*< ncnods=nunods >*/
- cirdat_1.ncnods = cirdat_1.nunods;
-
- /* assign program nodes */
-
- /*< 200 do 280 id=1,50 >*/
- /* L200: */
- for (id = 1; id <= 50; ++id) {
- /*< if (nnods(id).eq.0) go to 280 >*/
- if (nnods[id - 1] == 0) {
- goto L280;
- }
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 210 if (loc.eq.0) go to 280 >*/
- L210:
- if (loc == 0) {
- goto L280;
- }
- /*< if (id.le.4) go to 220 >*/
- if (id <= 4) {
- goto L220;
- }
- /*< if (id.le.8) go to 250 >*/
- if (id <= 8) {
- goto L250;
- }
- /*< if (id.eq.19) go to 265 >*/
- if (id == 19) {
- goto L265;
- }
- /*< if (id.le.40) go to 220 >*/
- if (id <= 40) {
- goto L220;
- }
- /*< if (id.le.43) go to 240 >*/
- if (id <= 43) {
- goto L240;
- }
- /*< 220 jstop=loc+nnods(id)-1 >*/
- L220:
- jstop = loc + nnods[id - 1] - 1;
- /*< do 230 j=loc,jstop >*/
- i_1 = jstop;
- for (j = loc; j <= i_1; ++j) {
- /*< call getnod(nodplc(j+2)) >*/
- getnod_(&nodplc[j + 1]);
- /*< 230 continue >*/
- /* L230: */
- }
- /*< go to 270 >*/
- goto L270;
- /*< 240 if (nodplc(loc+5).eq.0) go to 220 >*/
- L240:
- if (nodplc[loc + 4] == 0) {
- goto L220;
- }
- /*< go to 270 >*/
- goto L270;
- /*< 250 call getnod(nodplc(loc+2)) >*/
- L250:
- getnod_(&nodplc[loc + 1]);
- /*< call getnod(nodplc(loc+3)) >*/
- getnod_(&nodplc[loc + 2]);
- /*< if (id.ge.7) go to 270 >*/
- if (id >= 7) {
- goto L270;
- }
- /*< locp=nodplc(loc+id+1) >*/
- locp = nodplc[loc + id];
- /*< nssnod=2*nodplc(loc+4) >*/
- nssnod = nodplc[loc + 3] << 1;
- /*< 255 do 260 j=1,nssnod >*/
- L255:
- i_1 = nssnod;
- for (j = 1; j <= i_1; ++j) {
- /*< call getnod(nodplc(locp+j)) >*/
- getnod_(&nodplc[locp + j - 1]);
- /*< 260 continue >*/
- /* L260: */
- }
- /*< go to 270 >*/
- goto L270;
- /*< 265 locp=nodplc(loc+2) >*/
- L265:
- locp = nodplc[loc + 1];
- /*< call sizmem(nodplc(loc+2),nssnod) >*/
- sizmem_(&nodplc[loc + 1], &nssnod);
- /*< go to 255 >*/
- goto L255;
- /*< 270 loc=nodplc(loc) >*/
- L270:
- loc = nodplc[loc - 1];
- /*< go to 210 >*/
- goto L210;
- /*< 280 continue >*/
- L280:
- ;}
-
- /* check and set .nodeset nodes to their internal values */
-
- /*< call sizmem(nsnod,nic) >*/
- sizmem_(&tabinf_1.nsnod, &nic);
- /*< if(nic.eq.0) go to 300 >*/
- if (nic == 0) {
- goto L300;
- }
- /*< do 290 i=1,nic >*/
- i_1 = nic;
- for (i = 1; i <= i_1; ++i) {
- /*< call getnod(nodplc(nsnod+i)) >*/
- getnod_(&nodplc[tabinf_1.nsnod + i - 1]);
- /*< 290 continue >*/
- /* L290: */
- }
-
- /* check and set .ic nodes to their internal values */
-
- /*< 300 call sizmem(icnod,nic) >*/
- L300:
- sizmem_(&tabinf_1.icnod, &nic);
- /*< if(nic.eq.0) go to 320 >*/
- if (nic == 0) {
- goto L320;
- }
- /*< do 310 i=1,nic >*/
- i_1 = nic;
- for (i = 1; i <= i_1; ++i) {
- /*< call getnod(nodplc(icnod+i)) >*/
- getnod_(&nodplc[tabinf_1.icnod + i - 1]);
- /*< 310 continue >*/
- /* L310: */
- }
- /*< 320 if (nogo.ne.0) go to 2000 >*/
- L320:
- if (flags_1.nogo != 0) {
- goto L2000;
- }
-
- /* expand subcircuit calls */
-
- /*< call subckt >*/
- subckt_();
- /*< if (nogo.ne.0) go to 2000 >*/
- if (flags_1.nogo != 0) {
- goto L2000;
- }
- /*< if (ncnods.ge.2) go to 400 >*/
- if (cirdat_1.ncnods >= 2) {
- goto L400;
- }
- /*< write (iofile,321) >*/
- io__25.ciunit = status_1.iofile;
- s_wsfe(&io__25);
- e_wsfe();
- /*< 321 format('0*error*: circuit has no nodes'/) >*/
- /*< nogo=1 >*/
- flags_1.nogo = 1;
- /*< go to 2000 >*/
- goto L2000;
- /*< 400 numnod=ncnods >*/
- L400:
- cirdat_1.numnod = cirdat_1.ncnods;
-
- /* link unsatisfied references */
-
- /*< call lnkref >*/
- lnkref_();
- /*< if (nogo.ne.0) go to 2000 >*/
- if (flags_1.nogo != 0) {
- goto L2000;
- }
-
- /* generate subcircuit element names */
-
- /*< if (jelcnt(19).eq.0) go to 530 >*/
- if (cirdat_1.jelcnt[18] == 0) {
- goto L530;
- }
- /*< do 520 id=1,24 >*/
- for (id = 1; id <= 24; ++id) {
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 510 if (loc.eq.0) go to 520 >*/
- L510:
- if (loc == 0) {
- goto L520;
- }
- /*< call subnam(loc) >*/
- subnam_(&loc);
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 510 >*/
- goto L510;
- /*< 520 continue >*/
- L520:
- ;}
-
- /* translate node initial conditions to device initial conditions */
- /* (capacitance, diode, bjt, jfet and mosfet only) when uic is */
- /* specified on the .tran card */
-
- /*< 530 if (nosolv.le.0) go to 600 >*/
- L530:
- if (status_1.nosolv <= 0) {
- goto L600;
- }
- /*< call sizmem(icnod,nic) >*/
- sizmem_(&tabinf_1.icnod, &nic);
- /*< if(nic.eq.0) go to 600 >*/
- if (nic == 0) {
- goto L600;
- }
- /*< call getm8(lvnim1,numnod) >*/
- getm8_(&tabinf_1.lvnim1, &cirdat_1.numnod);
- /*< call zero8(value(lvnim1+1),numnod) >*/
- zero8_(&blank_1.value[tabinf_1.lvnim1], &cirdat_1.numnod);
- /*< do 535 i=1,nic >*/
- i_1 = nic;
- for (i = 1; i <= i_1; ++i) {
- /*< node=nodplc(icnod+i) >*/
- node = nodplc[tabinf_1.icnod + i - 1];
- /*< 535 value(lvnim1+node)=value(icval+i) >*/
- /* L535: */
- blank_1.value[tabinf_1.lvnim1 + node - 1] = blank_1.value[
- tabinf_1.icval + i - 1];
- }
- /*< loc=locate(2) >*/
- loc = cirdat_1.locate[1];
- /*< 540 if(loc.eq.0) go to 550 >*/
- L540:
- if (loc == 0) {
- goto L550;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< if(value(locv+2).ne.0.0d0) go to 545 >*/
- if (blank_1.value[locv + 1] != 0.) {
- goto L545;
- }
- /*< node1=nodplc(loc+2) >*/
- node1 = nodplc[loc + 1];
- /*< node2=nodplc(loc+3) >*/
- node2 = nodplc[loc + 2];
- /*< value(locv+2)=value(lvnim1+node1)-value(lvnim1+node2) >*/
- blank_1.value[locv + 1] = blank_1.value[tabinf_1.lvnim1 + node1 - 1] -
- blank_1.value[tabinf_1.lvnim1 + node2 - 1];
- /*< 545 loc=nodplc(loc) >*/
- L545:
- loc = nodplc[loc - 1];
- /*< go to 540 >*/
- goto L540;
- /*< 550 loc=locate(11) >*/
- L550:
- loc = cirdat_1.locate[10];
- /*< 555 if(loc.eq.0) go to 565 >*/
- L555:
- if (loc == 0) {
- goto L565;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< if(value(locv+2).ne.0.0d0) go to 560 >*/
- if (blank_1.value[locv + 1] != 0.) {
- goto L560;
- }
- /*< node1=nodplc(loc+2) >*/
- node1 = nodplc[loc + 1];
- /*< node2=nodplc(loc+3) >*/
- node2 = nodplc[loc + 2];
- /*< value(locv+2)=value(lvnim1+node1)-value(lvnim1+node2) >*/
- blank_1.value[locv + 1] = blank_1.value[tabinf_1.lvnim1 + node1 - 1] -
- blank_1.value[tabinf_1.lvnim1 + node2 - 1];
- /*< 560 loc=nodplc(loc) >*/
- L560:
- loc = nodplc[loc - 1];
- /*< go to 555 >*/
- goto L555;
- /*< 565 loc=locate(12) >*/
- L565:
- loc = cirdat_1.locate[11];
- /*< 570 if(loc.eq.0) go to 580 >*/
- L570:
- if (loc == 0) {
- goto L580;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< node1=nodplc(loc+2) >*/
- node1 = nodplc[loc + 1];
- /*< node2=nodplc(loc+3) >*/
- node2 = nodplc[loc + 2];
- /*< node3=nodplc(loc+4) >*/
- node3 = nodplc[loc + 3];
- /*< if(value(locv+2).eq.0.0d0) value(locv+2)=value(lvnim1+node2)- >*/
- /*< 1 value(lvnim1+node3) >*/
- if (blank_1.value[locv + 1] == 0.) {
- blank_1.value[locv + 1] = blank_1.value[tabinf_1.lvnim1 + node2 - 1]
- - blank_1.value[tabinf_1.lvnim1 + node3 - 1];
- }
- /*< if(value(locv+3).eq.0.0d0) value(locv+3)=value(lvnim1+node1)- >*/
- /*< 1 value(lvnim1+node3) >*/
- if (blank_1.value[locv + 2] == 0.) {
- blank_1.value[locv + 2] = blank_1.value[tabinf_1.lvnim1 + node1 - 1]
- - blank_1.value[tabinf_1.lvnim1 + node3 - 1];
- }
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 570 >*/
- goto L570;
- /*< 580 loc=locate(13) >*/
- L580:
- loc = cirdat_1.locate[12];
- /*< 585 if(loc.eq.0) go to 590 >*/
- L585:
- if (loc == 0) {
- goto L590;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< node1=nodplc(loc+2) >*/
- node1 = nodplc[loc + 1];
- /*< node2=nodplc(loc+3) >*/
- node2 = nodplc[loc + 2];
- /*< node3=nodplc(loc+4) >*/
- node3 = nodplc[loc + 3];
- /*< if(value(locv+2).eq.0.0d0) value(locv+2)=value(lvnim1+node1)- >*/
- /*< 1 value(lvnim1+node3) >*/
- if (blank_1.value[locv + 1] == 0.) {
- blank_1.value[locv + 1] = blank_1.value[tabinf_1.lvnim1 + node1 - 1]
- - blank_1.value[tabinf_1.lvnim1 + node3 - 1];
- }
- /*< if(value(locv+3).eq.0.0d0) value(locv+3)=value(lvnim1+node2)- >*/
- /*< 1 value(lvnim1+node3) >*/
- if (blank_1.value[locv + 2] == 0.) {
- blank_1.value[locv + 2] = blank_1.value[tabinf_1.lvnim1 + node2 - 1]
- - blank_1.value[tabinf_1.lvnim1 + node3 - 1];
- }
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 585 >*/
- goto L585;
- /*< 590 loc=locate(14) >*/
- L590:
- loc = cirdat_1.locate[13];
- /*< 595 if(loc.eq.0) go to 598 >*/
- L595:
- if (loc == 0) {
- goto L598;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< node1=nodplc(loc+2) >*/
- node1 = nodplc[loc + 1];
- /*< node2=nodplc(loc+3) >*/
- node2 = nodplc[loc + 2];
- /*< node3=nodplc(loc+4) >*/
- node3 = nodplc[loc + 3];
- /*< node4=nodplc(loc+5) >*/
- node4 = nodplc[loc + 4];
- /*< if(value(locv+5).eq.0.0d0) value(locv+5)=value(lvnim1+node1)- >*/
- /*< 1 value(lvnim1+node3) >*/
- if (blank_1.value[locv + 4] == 0.) {
- blank_1.value[locv + 4] = blank_1.value[tabinf_1.lvnim1 + node1 - 1]
- - blank_1.value[tabinf_1.lvnim1 + node3 - 1];
- }
- /*< if(value(locv+6).eq.0.0d0) value(locv+6)=value(lvnim1+node2)- >*/
- /*< 1 value(lvnim1+node3) >*/
- if (blank_1.value[locv + 5] == 0.) {
- blank_1.value[locv + 5] = blank_1.value[tabinf_1.lvnim1 + node2 - 1]
- - blank_1.value[tabinf_1.lvnim1 + node3 - 1];
- }
- /*< if(value(locv+7).eq.0.0d0) value(locv+7)=value(lvnim1+node4)- >*/
- /*< 1 value(lvnim1+node3) >*/
- if (blank_1.value[locv + 6] == 0.) {
- blank_1.value[locv + 6] = blank_1.value[tabinf_1.lvnim1 + node4 - 1]
- - blank_1.value[tabinf_1.lvnim1 + node3 - 1];
- }
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 595 >*/
- goto L595;
- /*< 598 call clrmem(lvnim1) >*/
- L598:
- clrmem_(&tabinf_1.lvnim1);
-
- /* process sources */
-
- /*< 600 if (jtrflg.eq.0) go to 700 >*/
- L600:
- if (tran_1.jtrflg == 0) {
- goto L700;
- }
- /*< do 690 id=9,10 >*/
- for (id = 9; id <= 10; ++id) {
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 610 if (loc.eq.0) go to 690 >*/
- L610:
- if (loc == 0) {
- goto L690;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< locp=nodplc(loc+5) >*/
- locp = nodplc[loc + 4];
- /*< jtype=nodplc(loc+4)+1 >*/
- jtype = nodplc[loc + 3] + 1;
- /*< go to (680,620,630,640,650,675), jtype >*/
- switch (jtype) {
- case 1: goto L680;
- case 2: goto L620;
- case 3: goto L630;
- case 4: goto L640;
- case 5: goto L650;
- case 6: goto L675;
- }
- /*< 620 value(locp+3)=dmax1(value(locp+3),0.0d0) >*/
- L620:
- /* Computing MAX */
- d_1 = blank_1.value[locp + 2];
- blank_1.value[locp + 2] = max(0.,d_1);
- /*< if (value(locp+4).le.0.0d0) value(locp+4)=tstep >*/
- if (blank_1.value[locp + 3] <= 0.) {
- blank_1.value[locp + 3] = tran_1.tstep;
- }
- /*< if (value(locp+5).le.0.0d0) value(locp+5)=tstep >*/
- if (blank_1.value[locp + 4] <= 0.) {
- blank_1.value[locp + 4] = tran_1.tstep;
- }
- /*< if (value(locp+6).le.0.0d0) value(locp+6)=tstop >*/
- if (blank_1.value[locp + 5] <= 0.) {
- blank_1.value[locp + 5] = tran_1.tstop;
- }
- /*< if (value(locp+7).le.0.0d0) value(locp+7)=tstop >*/
- if (blank_1.value[locp + 6] <= 0.) {
- blank_1.value[locp + 6] = tran_1.tstop;
- }
- /*< temp=value(locp+4)+value(locp+5)+value(locp+6) >*/
- temp = blank_1.value[locp + 3] + blank_1.value[locp + 4] +
- blank_1.value[locp + 5];
- /*< value(locp+7)=dmax1(value(locp+7),temp) >*/
- /* Computing MAX */
- d_1 = blank_1.value[locp + 6];
- blank_1.value[locp + 6] = max(temp,d_1);
- /*< value(locv+1)=value(locp+1) >*/
- blank_1.value[locv] = blank_1.value[locp];
- /*< go to 680 >*/
- goto L680;
- /*< 630 if (value(locp+3).le.0.0d0) value(locp+3)=1.0d0/tstop >*/
- L630:
- if (blank_1.value[locp + 2] <= 0.) {
- blank_1.value[locp + 2] = 1. / tran_1.tstop;
- }
- /*< value(locp+4)=dmax1(value(locp+4),0.0d0) >*/
- /* Computing MAX */
- d_1 = blank_1.value[locp + 3];
- blank_1.value[locp + 3] = max(0.,d_1);
- /*< value(locv+1)=value(locp+1) >*/
- blank_1.value[locv] = blank_1.value[locp];
- /*< go to 680 >*/
- goto L680;
- /*< 640 value(locp+3)=dmax1(value(locp+3),0.0d0) >*/
- L640:
- /* Computing MAX */
- d_1 = blank_1.value[locp + 2];
- blank_1.value[locp + 2] = max(0.,d_1);
- /*< if (value(locp+4).le.0.0d0) value(locp+4)=tstep >*/
- if (blank_1.value[locp + 3] <= 0.) {
- blank_1.value[locp + 3] = tran_1.tstep;
- }
- /*< if (value(locp+5).le.value(locp+3)) >*/
- /*< 1 value(locp+5)=value(locp+3)+tstep >*/
- if (blank_1.value[locp + 4] <= blank_1.value[locp + 2]) {
- blank_1.value[locp + 4] = blank_1.value[locp + 2] + tran_1.tstep;
- }
- /*< if (value(locp+6).le.0.0d0) value(locp+6)=tstep >*/
- if (blank_1.value[locp + 5] <= 0.) {
- blank_1.value[locp + 5] = tran_1.tstep;
- }
- /*< value(locv+1)=value(locp+1) >*/
- blank_1.value[locv] = blank_1.value[locp];
- /*< go to 680 >*/
- goto L680;
- /*< 650 value(locp+1)=dmin1(dmax1(value(locp+1),0.0d0),tstop) >*/
- L650:
- /* Computing MAX */
- /* Computing MAX */
- d_2 = blank_1.value[locp];
- d_1 = max(0.,d_2);
- blank_1.value[locp] = min(tran_1.tstop,d_1);
- /*< iknt=1 >*/
- iknt = 1;
- /*< call sizmem(nodplc(loc+5),nump) >*/
- sizmem_(&nodplc[loc + 4], &nump);
- /*< 660 temp=value(locp+iknt) >*/
- L660:
- temp = blank_1.value[locp + iknt - 1];
- /*< if (value(locp+iknt+2).eq.0.0d0) go to 670 >*/
- if (blank_1.value[locp + iknt + 1] == 0.) {
- goto L670;
- }
- /*< if (value(locp+iknt+2).ge.tstop) go to 670 >*/
- if (blank_1.value[locp + iknt + 1] >= tran_1.tstop) {
- goto L670;
- }
- /*< value(locp+iknt+2)=dmax1(value(locp+iknt+2),temp) >*/
- /* Computing MAX */
- d_1 = blank_1.value[locp + iknt + 1];
- blank_1.value[locp + iknt + 1] = max(temp,d_1);
- /*< if(temp.ne.value(locp+iknt+2)) go to 665 >*/
- if (temp != blank_1.value[locp + iknt + 1]) {
- goto L665;
- }
- /*< write(iofile,661) value(locv) >*/
- io__35.ciunit = status_1.iofile;
- s_wsfe(&io__35);
- do_fio(&c__1, (char *)&blank_1.value[locv - 1], (ftnlen)sizeof(
- doublereal));
- e_wsfe();
- /*< 661 format('0*error*: element ',a8,' piecewise linear source table no >*/
- /*< 1t increasing in time') >*/
- /*< nogo=1 >*/
- flags_1.nogo = 1;
- /*< 665 iknt=iknt+2 >*/
- L665:
- iknt += 2;
- /*< if (iknt.lt.nump) go to 660 >*/
- if (iknt < nump) {
- goto L660;
- }
- /*< 670 value(locp+iknt+2)=tstop >*/
- L670:
- blank_1.value[locp + iknt + 1] = tran_1.tstop;
- /*< value(locv+1)=value(locp+2) >*/
- blank_1.value[locv] = blank_1.value[locp + 1];
- /*< call relmem(nodplc(loc+5),nump-iknt-3) >*/
- i_1 = nump - iknt - 3;
- relmem_(&nodplc[loc + 4], &i_1);
- /*< go to 680 >*/
- goto L680;
- /*< 675 if (value(locp+3).le.0.0d0) value(locp+3)=1.0d0/tstop >*/
- L675:
- if (blank_1.value[locp + 2] <= 0.) {
- blank_1.value[locp + 2] = 1. / tran_1.tstop;
- }
- /*< if (value(locp+5).le.0.0d0) value(locp+5)=1.0d0/tstop >*/
- if (blank_1.value[locp + 4] <= 0.) {
- blank_1.value[locp + 4] = 1. / tran_1.tstop;
- }
- /*< value(locv+1)=value(locp+1) >*/
- blank_1.value[locv] = blank_1.value[locp];
- /*< 680 loc=nodplc(loc) >*/
- L680:
- loc = nodplc[loc - 1];
- /*< go to 610 >*/
- goto L610;
- /*< 690 continue >*/
- L690:
- ;}
-
- /* use default values for mos device geometries if not specified */
-
- /*< 700 loc=locate(14) >*/
- L700:
- loc = cirdat_1.locate[13];
- /*< 710 if(loc.eq.0) go to 720 >*/
- L710:
- if (loc == 0) {
- goto L720;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< if(value(locv+1).le.0.0d0) value(locv+1)=defl >*/
- if (blank_1.value[locv] <= 0.) {
- blank_1.value[locv] = miscel_1.defl;
- }
- /*< if(value(locv+2).le.0.0d0) value(locv+2)=defw >*/
- if (blank_1.value[locv + 1] <= 0.) {
- blank_1.value[locv + 1] = miscel_1.defw;
- }
- /*< if(value(locv+3).le.0.0d0) value(locv+3)=defad >*/
- if (blank_1.value[locv + 2] <= 0.) {
- blank_1.value[locv + 2] = miscel_1.defad;
- }
- /*< if(value(locv+4).le.0.0d0) value(locv+4)=defas >*/
- if (blank_1.value[locv + 3] <= 0.) {
- blank_1.value[locv + 3] = miscel_1.defas;
- }
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 710 >*/
- goto L710;
-
- /* print listing of elements, process device models, */
- /* and check topology */
-
- /*< 720 if (iprntl.eq.0) go to 730 >*/
- L720:
- if (flags_1.iprntl == 0) {
- goto L730;
- }
- /*< call elprnt >*/
- elprnt_();
- /*< 730 call topchk >*/
- L730:
- topchk_();
- /*< call modchk >*/
- modchk_();
- /*< if (nogo.ne.0) go to 2000 >*/
- if (flags_1.nogo != 0) {
- goto L2000;
- }
-
- /* invert resistance values */
-
- /*< 800 loc=locate(1) >*/
- /* L800: */
- loc = cirdat_1.locate[0];
- /*< 810 if (loc.eq.0) go to 900 >*/
- L810:
- if (loc == 0) {
- goto L900;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< value(locv+1)=1.0d0/value(locv+2) >*/
- blank_1.value[locv] = 1. / blank_1.value[locv + 1];
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 810 >*/
- goto L810;
-
- /* process mutual inductors */
-
- /*< 900 loc=locate(4) >*/
- L900:
- loc = cirdat_1.locate[3];
- /*< 910 if (loc.eq.0) go to 1000 >*/
- L910:
- if (loc == 0) {
- goto L1000;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< nl1=nodplc(loc+2) >*/
- nl1 = nodplc[loc + 1];
- /*< lptr1=nodplc(nl1+1) >*/
- lptr1 = nodplc[nl1];
- /*< nl2=nodplc(loc+3) >*/
- nl2 = nodplc[loc + 2];
- /*< lptr2=nodplc(nl2+1) >*/
- lptr2 = nodplc[nl2];
- /*< value(locv+1)=value(locv+1)*dsqrt(value(lptr1+1)*value(lptr2+1)) >*/
- blank_1.value[locv] *= sqrt(blank_1.value[lptr1] * blank_1.value[lptr2]);
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 910 >*/
- goto L910;
-
- /* limit delmax if transmission lines in circuit */
-
- /*< 1000 if (jtrflg.eq.0) go to 1200 >*/
- L1000:
- if (tran_1.jtrflg == 0) {
- goto L1200;
- }
- /*< tdmax=0.0d0 >*/
- tran_1.tdmax = 0.;
- /*< loc=locate(17) >*/
- loc = cirdat_1.locate[16];
- /*< 1010 if (loc.eq.0) go to 1200 >*/
- L1010:
- if (loc == 0) {
- goto L1200;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< delmax=dmin1(delmax,value(locv+2)/2.0d0) >*/
- /* Computing MAX */
- d_1 = tran_1.delmax, d_2 = blank_1.value[locv + 1] / 2.;
- tran_1.delmax = min(d_2,d_1);
- /*< tdmax=dmax1(tdmax,value(locv+2)) >*/
- /* Computing MAX */
- d_1 = tran_1.tdmax, d_2 = blank_1.value[locv + 1];
- tran_1.tdmax = max(d_2,d_1);
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 1010 >*/
- goto L1010;
-
- /* process source parameters */
-
- /*< 1200 numbkp=0 >*/
- L1200:
- tabinf_1.numbkp = 0;
- /*< if (jtrflg.eq.0) go to 1205 >*/
- if (tran_1.jtrflg == 0) {
- goto L1205;
- }
- /*< tol=1.0d-2*delmax >*/
- tol = tran_1.delmax * .01;
- /*< numbkp=2 >*/
- tabinf_1.numbkp = 2;
- /*< call getm8(lsbkpt,numbkp) >*/
- getm8_(&tabinf_1.lsbkpt, &tabinf_1.numbkp);
- /*< value(lsbkpt+1)=0.0d0 >*/
- blank_1.value[tabinf_1.lsbkpt] = 0.;
- /*< value(lsbkpt+2)=tstop >*/
- blank_1.value[tabinf_1.lsbkpt + 1] = tran_1.tstop;
- /*< 1205 do 1290 id=9,10 >*/
- L1205:
- for (id = 9; id <= 10; ++id) {
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 1210 if (loc.eq.0) go to 1290 >*/
- L1210:
- if (loc == 0) {
- goto L1290;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< locp=nodplc(loc+5) >*/
- locp = nodplc[loc + 4];
- /*< temp=value(locv+3)/rad >*/
- temp = blank_1.value[locv + 2] / knstnt_1.rad;
- /*< value(locv+3)=value(locv+2)*dsin(temp) >*/
- blank_1.value[locv + 2] = blank_1.value[locv + 1] * sin(temp);
- /*< value(locv+2)=value(locv+2)*dcos(temp) >*/
- blank_1.value[locv + 1] *= cos(temp);
- /*< if (jtrflg.eq.0) go to 1280 >*/
- if (tran_1.jtrflg == 0) {
- goto L1280;
- }
- /*< jtype=nodplc(loc+4)+1 >*/
- jtype = nodplc[loc + 3] + 1;
- /*< go to (1280,1220,1230,1235,1240,1260), jtype >*/
- switch (jtype) {
- case 1: goto L1280;
- case 2: goto L1220;
- case 3: goto L1230;
- case 4: goto L1235;
- case 5: goto L1240;
- case 6: goto L1260;
- }
- /*< 1220 value(locp+4)=value(locp+4)+value(locp+3) >*/
- L1220:
- blank_1.value[locp + 3] += blank_1.value[locp + 2];
- /*< temp=value(locp+5) >*/
- temp = blank_1.value[locp + 4];
- /*< value(locp+5)=value(locp+4)+value(locp+6) >*/
- blank_1.value[locp + 4] = blank_1.value[locp + 3] + blank_1.value[
- locp + 5];
- /*< value(locp+6)=value(locp+5)+temp >*/
- blank_1.value[locp + 5] = blank_1.value[locp + 4] + temp;
- /*< time=0.0d0 >*/
- status_1.time = 0.;
- /*< 1225 call extmem(lsbkpt,4) >*/
- L1225:
- extmem_(&tabinf_1.lsbkpt, &c__4);
- /*< value(lsbkpt+numbkp+1)=value(locp+3)+time >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp] = blank_1.value[locp
- + 2] + status_1.time;
- /*< value(lsbkpt+numbkp+2)=value(locp+4)+time >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp + 1] = blank_1.value[
- locp + 3] + status_1.time;
- /*< value(lsbkpt+numbkp+3)=value(locp+5)+time >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp + 2] = blank_1.value[
- locp + 4] + status_1.time;
- /*< value(lsbkpt+numbkp+4)=value(locp+6)+time >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp + 3] = blank_1.value[
- locp + 5] + status_1.time;
- /*< numbkp=numbkp+4 >*/
- tabinf_1.numbkp += 4;
- /*< time=time+value(locp+7) >*/
- status_1.time += blank_1.value[locp + 6];
- /*< if (time.ge.tstop) go to 1280 >*/
- if (status_1.time >= tran_1.tstop) {
- goto L1280;
- }
- /*< go to 1225 >*/
- goto L1225;
- /*< 1230 value(locp+3)=value(locp+3)*twopi >*/
- L1230:
- blank_1.value[locp + 2] *= knstnt_1.twopi;
- /*< call extmem(lsbkpt,1) >*/
- extmem_(&tabinf_1.lsbkpt, &c__1);
- /*< 1231 value(lsbkpt+numbkp+1)=value(locp+4) >*/
- /* L1231: */
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp] = blank_1.value[locp
- + 3];
- /*< numbkp=numbkp+1 >*/
- ++tabinf_1.numbkp;
- /*< go to 1280 >*/
- goto L1280;
- /*< 1235 call extmem(lsbkpt,2) >*/
- L1235:
- extmem_(&tabinf_1.lsbkpt, &c__2);
- /*< value(lsbkpt+numbkp+1)=value(locp+3) >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp] = blank_1.value[locp
- + 2];
- /*< value(lsbkpt+numbkp+2)=value(locp+5) >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp + 1] = blank_1.value[
- locp + 4];
- /*< numbkp=numbkp+2 >*/
- tabinf_1.numbkp += 2;
- /*< go to 1280 >*/
- goto L1280;
- /*< 1240 iknt=1 >*/
- L1240:
- iknt = 1;
- /*< call sizmem(nodplc(loc+5),nump) >*/
- sizmem_(&nodplc[loc + 4], &nump);
- /*< 1250 call extmem(lsbkpt,1) >*/
- L1250:
- extmem_(&tabinf_1.lsbkpt, &c__1);
- /*< value(lsbkpt+numbkp+1)=value(locp+iknt) >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp] = blank_1.value[locp
- + iknt - 1];
- /*< numbkp=numbkp+1 >*/
- ++tabinf_1.numbkp;
- /*< iknt=iknt+2 >*/
- iknt += 2;
- /*< if (iknt.le.nump) go to 1250 >*/
- if (iknt <= nump) {
- goto L1250;
- }
- /*< go to 1280 >*/
- goto L1280;
- /*< 1260 value(locp+3)=value(locp+3)*twopi >*/
- L1260:
- blank_1.value[locp + 2] *= knstnt_1.twopi;
- /*< value(locp+5)=value(locp+5)*twopi >*/
- blank_1.value[locp + 4] *= knstnt_1.twopi;
- /*< 1280 loc=nodplc(loc) >*/
- L1280:
- loc = nodplc[loc - 1];
- /*< go to 1210 >*/
- goto L1210;
- /*< 1290 continue >*/
- L1290:
- ;}
-
- /* augment breakpoint table for transmission line delays */
-
- /*< if (jtrflg.eq.0) go to 1300 >*/
- if (tran_1.jtrflg == 0) {
- goto L1300;
- }
- /*< loc=locate(17) >*/
- loc = cirdat_1.locate[16];
- /*< 1292 if (loc.eq.0) go to 1300 >*/
- L1292:
- if (loc == 0) {
- goto L1300;
- }
- /*< locv=nodplc(loc+1) >*/
- locv = nodplc[loc];
- /*< td=value(locv+2) >*/
- td = blank_1.value[locv + 1];
- /*< ntemp=numbkp >*/
- ntemp = tabinf_1.numbkp;
- /*< do 1296 ibkp=1,ntemp >*/
- i_1 = ntemp;
- for (ibkp = 1; ibkp <= i_1; ++ibkp) {
- /*< time=value(lsbkpt+ibkp) >*/
- status_1.time = blank_1.value[tabinf_1.lsbkpt + ibkp - 1];
- /*< 1294 time=time+td >*/
- L1294:
- status_1.time += td;
- /*< if (time.ge.tstop) go to 1296 >*/
- if (status_1.time >= tran_1.tstop) {
- goto L1296;
- }
- /*< call extmem(lsbkpt,1) >*/
- extmem_(&tabinf_1.lsbkpt, &c__1);
- /*< value(lsbkpt+numbkp+1)=time >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp] = status_1.time;
- /*< numbkp=numbkp+1 >*/
- ++tabinf_1.numbkp;
- /*< go to 1294 >*/
- goto L1294;
- /*< 1296 continue >*/
- L1296:
- ;}
- /*< call shlsrt(value(lsbkpt+1),numbkp) >*/
- shlsrt_(&blank_1.value[tabinf_1.lsbkpt], &tabinf_1.numbkp);
- /*< nbkpt=1 >*/
- nbkpt = 1;
- /*< do 1298 i=2,numbkp >*/
- i_1 = tabinf_1.numbkp;
- for (i = 2; i <= i_1; ++i) {
- /*< if ((value(lsbkpt+i)-value(lsbkpt+nbkpt)).lt.tol) go to 1298 >*/
- if (blank_1.value[tabinf_1.lsbkpt + i - 1] - blank_1.value[
- tabinf_1.lsbkpt + nbkpt - 1] < tol) {
- goto L1298;
- }
- /*< nbkpt=nbkpt+1 >*/
- ++nbkpt;
- /*< value(lsbkpt+nbkpt)=value(lsbkpt+i) >*/
- blank_1.value[tabinf_1.lsbkpt + nbkpt - 1] = blank_1.value[
- tabinf_1.lsbkpt + i - 1];
- /*< if (value(lsbkpt+nbkpt).ge.tstop) go to 1299 >*/
- if (blank_1.value[tabinf_1.lsbkpt + nbkpt - 1] >= tran_1.tstop) {
- goto L1299;
- }
- /*< 1298 continue >*/
- L1298:
- ;}
- /*< 1299 call relmem(lsbkpt,numbkp-nbkpt) >*/
- L1299:
- i_1 = tabinf_1.numbkp - nbkpt;
- relmem_(&tabinf_1.lsbkpt, &i_1);
- /*< numbkp=nbkpt >*/
- tabinf_1.numbkp = nbkpt;
- /*< value(lsbkpt+numbkp)=dmax1(value(lsbkpt+numbkp),tstop) >*/
- /* Computing MAX */
- d_1 = blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp - 1];
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp - 1] = max(tran_1.tstop,
- d_1);
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 1292 >*/
- goto L1292;
-
- /* finish breakpoint table */
-
- /*< 1300 if (jtrflg.eq.0) go to 1600 >*/
- L1300:
- if (tran_1.jtrflg == 0) {
- goto L1600;
- }
- /*< call extmem(lsbkpt,1) >*/
- extmem_(&tabinf_1.lsbkpt, &c__1);
- /*< value(lsbkpt+numbkp+1)=tstop >*/
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp] = tran_1.tstop;
- /*< numbkp=numbkp+1 >*/
- ++tabinf_1.numbkp;
- /*< call shlsrt(value(lsbkpt+1),numbkp) >*/
- shlsrt_(&blank_1.value[tabinf_1.lsbkpt], &tabinf_1.numbkp);
- /*< nbkpt=1 >*/
- nbkpt = 1;
- /*< do 1310 i=2,numbkp >*/
- i_1 = tabinf_1.numbkp;
- for (i = 2; i <= i_1; ++i) {
- /*< if ((value(lsbkpt+i)-value(lsbkpt+nbkpt)).lt.tol) go to 1310 >*/
- if (blank_1.value[tabinf_1.lsbkpt + i - 1] - blank_1.value[
- tabinf_1.lsbkpt + nbkpt - 1] < tol) {
- goto L1310;
- }
- /*< nbkpt=nbkpt+1 >*/
- ++nbkpt;
- /*< value(lsbkpt+nbkpt)=value(lsbkpt+i) >*/
- blank_1.value[tabinf_1.lsbkpt + nbkpt - 1] = blank_1.value[
- tabinf_1.lsbkpt + i - 1];
- /*< if (value(lsbkpt+nbkpt).ge.tstop) go to 1320 >*/
- if (blank_1.value[tabinf_1.lsbkpt + nbkpt - 1] >= tran_1.tstop) {
- goto L1320;
- }
- /*< 1310 continue >*/
- L1310:
- ;}
- /*< 1320 call relmem(lsbkpt,numbkp-nbkpt) >*/
- L1320:
- i_1 = tabinf_1.numbkp - nbkpt;
- relmem_(&tabinf_1.lsbkpt, &i_1);
- /*< numbkp=nbkpt >*/
- tabinf_1.numbkp = nbkpt;
- /*< value(lsbkpt+numbkp)=dmax1(value(lsbkpt+numbkp),tstop) >*/
- /* Computing MAX */
- d_1 = blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp - 1];
- blank_1.value[tabinf_1.lsbkpt + tabinf_1.numbkp - 1] = max(tran_1.tstop,
- d_1);
-
- /* print option summary */
-
- /*< 1600 if (iprnto.eq.0) go to 1700 >*/
- L1600:
- if (flags_1.iprnto == 0) {
- goto L1700;
- }
- /*< call title(0,lwidth,1,titlop) >*/
- title_(&c__0, &miscel_1.lwidth, &c__1, titlop);
- /*< write (iofile,1601) gmin,reltol,abstol,vntol,lvlcod,itl1,itl2 >*/
- io__45.ciunit = status_1.iofile;
- s_wsfe(&io__45);
- do_fio(&c__1, (char *)&knstnt_1.gmin, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&knstnt_1.reltol, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&knstnt_1.abstol, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&knstnt_1.vntol, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&flags_1.lvlcod, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&flags_1.itl1, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&flags_1.itl2, (ftnlen)sizeof(integer));
- e_wsfe();
- /*< 1601 format('0dc analysis -',/, >*/
- /*< 1 '0 gmin = ',1pd10.3,/, >*/
- /*< 2 ' reltol = ', d10.3,/, >*/
- /*< 3 ' abstol = ', d10.3,/, >*/
- /*< 4 ' vntol = ', d10.3,/, >*/
- /*< 5 ' lvlcod = ', i6,/, >*/
- /*< 6 ' itl1 = ', i6,/, >*/
- /*< 7 ' itl2 = ', i6,/) >*/
- /*< write (iofile,1605) pivtol,pivrel >*/
- io__46.ciunit = status_1.iofile;
- s_wsfe(&io__46);
- do_fio(&c__1, (char *)&knstnt_1.pivtol, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&knstnt_1.pivrel, (ftnlen)sizeof(doublereal));
- e_wsfe();
- /*< 1605 format( >*/
- /*< 1 ' pivtol = ',1pd10.3,/, >*/
- /*< 2 ' pivrel = ', d10.3) >*/
- /*< write (iofile,1611) aname(method),maxord,chgtol,trtol,lvltim,xmu, >*/
- /*< 1 itl3,itl4,itl5 >*/
- io__47.ciunit = status_1.iofile;
- s_wsfe(&io__47);
- do_fio(&c__1, (char *)&aname[status_1.method - 1], (ftnlen)sizeof(
- doublereal));
- do_fio(&c__1, (char *)&status_1.maxord, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&knstnt_1.chgtol, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&knstnt_1.trtol, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&flags_1.lvltim, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&status_1.xmu, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&flags_1.itl3, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&flags_1.itl4, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&flags_1.itl5, (ftnlen)sizeof(integer));
- e_wsfe();
- /*< 1611 format('0transient analysis -',/, >*/
- /*< 1 '0 method = ',a8,/, >*/
- /*< 2 ' maxord = ', i6,/, >*/
- /*< 3 ' chgtol = ',1pd10.3,/, >*/
- /*< 4 ' trtol = ', d10.3,/, >*/
- /*< 5 ' lvltim = ', i6,/, >*/
- /*< 6 ' mu = ',0pf10.3,/, >*/
- /*< 7 ' itl3 = ', i6,/, >*/
- /*< 8 ' itl4 = ', i6,/, >*/
- /*< 9 ' itl5 = ', i6,/) >*/
- /*< write (iofile,1621) limpts,limtim,maxtim,numdgt,value(itemps+1), >*/
- /*< 1 defl,defw,defad,defas >*/
- io__48.ciunit = status_1.iofile;
- s_wsfe(&io__48);
- do_fio(&c__1, (char *)&flags_1.limpts, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&flags_1.limtim, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&cje_1.maxtim, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&outinf_1.numdgt, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&blank_1.value[tabinf_1.itemps], (ftnlen)sizeof(
- doublereal));
- do_fio(&c__1, (char *)&miscel_1.defl, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&miscel_1.defw, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&miscel_1.defad, (ftnlen)sizeof(doublereal));
- do_fio(&c__1, (char *)&miscel_1.defas, (ftnlen)sizeof(doublereal));
- e_wsfe();
- /*< 1621 format('0miscellaneous -',/, >*/
- /*< 1 '0 limpts = ', i6,/, >*/
- /*< 2 ' limtim = ', i6,/, >*/
- /*< 3 ' cptime = ', i9,/, >*/
- /*< 4 ' numdgt = ', i6,/, >*/
- /*< 5 ' tnom = ',0pf10.3,/, >*/
- /*< 6 ' defl = ',1pd10.3,/, >*/
- /*< 7 ' defw = ',d10.3,/, >*/
- /*< 8 ' defad = ',d10.3,/, >*/
- /*< 9 ' defas = ',d10.3) >*/
-
- /* miscellaneous error checking */
-
- /*< 1700 if (icvflg.eq.0) go to 1720 >*/
- L1700:
- if (dc_1.icvflg == 0) {
- goto L1720;
- }
- /*< if (icvflg.le.limpts) go to 1710 >*/
- if (dc_1.icvflg <= flags_1.limpts) {
- goto L1710;
- }
- /*< icvflg=0 >*/
- dc_1.icvflg = 0;
- /*< write (iofile,1701) limpts,alsdc >*/
- io__49.ciunit = status_1.iofile;
- s_wsfe(&io__49);
- do_fio(&c__1, (char *)&flags_1.limpts, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&alsdc, (ftnlen)sizeof(doublereal));
- e_wsfe();
- /*< 1701 format('0warning: more than ',i5,' points for ',a4,' analysis,',/ >*/
- /*< 11x,'analysis omitted. this limit may be overridden using the ',/ >*/
- /*< 21x,'limpts parameter on the .option card'/) >*/
- /*< go to 1720 >*/
- goto L1720;
- /*< 1710 if ((jelcnt(31)+jelcnt(36)).gt.0) go to 1720 >*/
- L1710:
- if (cirdat_1.jelcnt[30] + cirdat_1.jelcnt[35] > 0) {
- goto L1720;
- }
- /*< if(ipostp.ne.0) go to 1720 >*/
- if (status_1.ipostp != 0) {
- goto L1720;
- }
- /*< icvflg=0 >*/
- dc_1.icvflg = 0;
- /*< write (iofile,1711) alsdc >*/
- io__50.ciunit = status_1.iofile;
- s_wsfe(&io__50);
- do_fio(&c__1, (char *)&alsdc, (ftnlen)sizeof(doublereal));
- e_wsfe();
- /*< 1711 format('0warning: no ',a4,' outputs specified .', >*/
- /*< 1 '.. analysis omitted'/) >*/
- /*< 1720 if (jtrflg.eq.0) go to 1740 >*/
- L1720:
- if (tran_1.jtrflg == 0) {
- goto L1740;
- }
- /*< if (method.eq.1) maxord=2 >*/
- if (status_1.method == 1) {
- status_1.maxord = 2;
- }
- /*< if ((method.eq.2).and.(maxord.ge.3)) lvltim=2 >*/
- if (status_1.method == 2 && status_1.maxord >= 3) {
- flags_1.lvltim = 2;
- }
- /*< if (jtrflg.le.limpts) go to 1730 >*/
- if (tran_1.jtrflg <= flags_1.limpts) {
- goto L1730;
- }
- /*< jtrflg=0 >*/
- tran_1.jtrflg = 0;
- /*< write (iofile,1701) limpts,alstr >*/
- io__51.ciunit = status_1.iofile;
- s_wsfe(&io__51);
- do_fio(&c__1, (char *)&flags_1.limpts, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&alstr, (ftnlen)sizeof(doublereal));
- e_wsfe();
- /*< go to 1740 >*/
- goto L1740;
- /*< 1730 if ((jelcnt(32)+jelcnt(37)+nfour).gt.0) go to 1735 >*/
- L1730:
- if (cirdat_1.jelcnt[31] + cirdat_1.jelcnt[36] + tabinf_1.nfour > 0) {
- goto L1735;
- }
- /*< if(ipostp.ne.0) go to 1735 >*/
- if (status_1.ipostp != 0) {
- goto L1735;
- }
- /*< jtrflg=0 >*/
- tran_1.jtrflg = 0;
- /*< write (iofile,1711) alstr >*/
- io__52.ciunit = status_1.iofile;
- s_wsfe(&io__52);
- do_fio(&c__1, (char *)&alstr, (ftnlen)sizeof(doublereal));
- e_wsfe();
- /*< go to 1740 >*/
- goto L1740;
- /*< 1735 if (nfour.eq.0) go to 1740 >*/
- L1735:
- if (tabinf_1.nfour == 0) {
- goto L1740;
- }
- /*< forprd=1.0d0/forfre >*/
- forprd = 1. / tran_1.forfre;
- /*< if ((tstop-forprd).ge.(tstart-1.0d-12)) go to 1740 >*/
- if (tran_1.tstop - forprd >= tran_1.tstart - 1e-12) {
- goto L1740;
- }
- /*< nfour=0 >*/
- tabinf_1.nfour = 0;
- /*< call clrmem(ifour) >*/
- clrmem_(&tabinf_1.ifour);
- /*< write (iofile,1736) >*/
- io__54.ciunit = status_1.iofile;
- s_wsfe(&io__54);
- e_wsfe();
- /*< 1736 format('0warning: fourier analysis fundamental frequency is incom >*/
- /*< 1patible with'/11x,'transient analysis print interval ... fourier a >*/
- /*< 2nalysis omitted'/) >*/
- /*< 1740 if (jacflg.eq.0) go to 1800 >*/
- L1740:
- if (ac_1.jacflg == 0) {
- goto L1800;
- }
- /*< if (jacflg.le.limpts) go to 1750 >*/
- if (ac_1.jacflg <= flags_1.limpts) {
- goto L1750;
- }
- /*< jacflg=0 >*/
- ac_1.jacflg = 0;
- /*< write (iofile,1701) limpts,alsac >*/
- io__55.ciunit = status_1.iofile;
- s_wsfe(&io__55);
- do_fio(&c__1, (char *)&flags_1.limpts, (ftnlen)sizeof(integer));
- do_fio(&c__1, (char *)&alsac, (ftnlen)sizeof(doublereal));
- e_wsfe();
- /*< go to 1800 >*/
- goto L1800;
- /*< 1750 if ((jelcnt(33)+jelcnt(34)+jelcnt(35)+jelcnt(38)+jelcnt(39) >*/
- /*< 1 +jelcnt(40)+idist+inoise).gt.0) go to 1800 >*/
- L1750:
- if (cirdat_1.jelcnt[32] + cirdat_1.jelcnt[33] + cirdat_1.jelcnt[34] +
- cirdat_1.jelcnt[37] + cirdat_1.jelcnt[38] + cirdat_1.jelcnt[39] +
- ac_1.idist + ac_1.inoise > 0) {
- goto L1800;
- }
- /*< if(ipostp.ne.0) go to 1800 >*/
- if (status_1.ipostp != 0) {
- goto L1800;
- }
- /*< jacflg=0 >*/
- ac_1.jacflg = 0;
- /*< write (iofile,1711) alsac >*/
- io__56.ciunit = status_1.iofile;
- s_wsfe(&io__56);
- do_fio(&c__1, (char *)&alsac, (ftnlen)sizeof(doublereal));
- e_wsfe();
-
- /* sequence through the output lists */
-
- /*< 1800 do 1820 id=41,45 >*/
- L1800:
- for (id = 41; id <= 45; ++id) {
- /*< if (id.le.43) numout=1 >*/
- if (id <= 43) {
- outinf_1.numout = 1;
- }
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 1810 if (loc.eq.0) go to 1820 >*/
- L1810:
- if (loc == 0) {
- goto L1820;
- }
- /*< numout=numout+1 >*/
- ++outinf_1.numout;
- /*< nodplc(loc+4)=numout >*/
- nodplc[loc + 3] = outinf_1.numout;
- /*< loc=nodplc(loc) >*/
- loc = nodplc[loc - 1];
- /*< go to 1810 >*/
- goto L1810;
- /*< 1820 continue >*/
- L1820:
- ;}
-
- /* increase number of .prints if too many outputs for output line-width
- */
-
- /*< ifwdth=max0(numdgt-1,0)+9 >*/
- /* Computing MAX */
- i_1 = outinf_1.numdgt - 1;
- ifwdth = max(0,i_1) + 9;
- /*< noprln=min0(8,(lwidth-12)/ifwdth) >*/
- /* Computing MAX */
- i_1 = 8, i_2 = (miscel_1.lwidth - 12) / ifwdth;
- noprln = min(i_2,i_1);
- /*< do 1860 id=31,35 >*/
- for (id = 31; id <= 35; ++id) {
- /*< loc=locate(id) >*/
- loc = cirdat_1.locate[id - 1];
- /*< 1830 if(loc.eq.0) go to 1860 >*/
- L1830:
- if (loc == 0) {
- goto L1860;
- }
- /*< noprex=nodplc(loc+3)-noprln >*/
- noprex = nodplc[loc + 2] - noprln;
- /*< if(noprex.le.0) go to 1850 >*/
- if (noprex <= 0) {
- goto L1850;
- }
- /*< nodplc(loc+3)=noprln >*/
- nodplc[loc + 2] = noprln;
- /*< call find(dble(jelcnt(id)),id,locnew,1) >*/
- d_1 = (doublereal) cirdat_1.jelcnt[id - 1];
- find_(&d_1, &id, &locnew, &c__1);
- /*< nodplc(locnew+2)=nodplc(loc+2) >*/
- nodplc[locnew + 1] = nodplc[loc + 1];
- /*< nodplc(locnew+3)=noprex >*/
- nodplc[locnew + 2] = noprex;
- /*< call copy4(nodplc(loc+2*noprln+4),nodplc(locnew+4),2*noprex) >*/
- i_1 = noprex << 1;
- copy4_(&nodplc[loc + (noprln << 1) + 3], &nodplc[locnew + 3], &i_1);
- /*< 1850 loc=nodplc(loc) >*/
- L1850:
- loc = nodplc[loc - 1];
- /*< go to 1830 >*/
- goto L1830;
- /*< 1860 continue >*/
- L1860:
- ;}
-
- /* exit */
-
- /*< 2000 call second(t2) >*/
- L2000:
- second_(&t2);
- /*< rstats(1)=rstats(1)+t2-t1 >*/
- miscel_1.rstats[0] = miscel_1.rstats[0] + t2 - t1;
- /*< return >*/
- return 0;
- /*< end >*/
- } /* errchk_ */
-
- #undef cvalue
- #undef nodplc
- #undef aoutpt
- #undef amodel
- #undef aelmt
- #undef ndefin
- #undef titlop
- #undef aname
- #undef alsac
- #undef alstr
- #undef alsdc
-
-
-